#reticulate::use_python("/anaconda3/bin/python")
library(readr)
library(ggplot2)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(methods)
library(stringi)
library(keras)
The dataset we will be using is ImageWoof. We are going to try and differentiate different dog breeds from one another.
Let’s read in the dataset we want to use! The CSV file is the metadata and the RDS file is the image data.
dogs <- read_csv("my-image-data.csv")
## Parsed with column specification:
## cols(
## obs_id = col_character(),
## train_id = col_character(),
## class = col_double(),
## class_name = col_character(),
## path_to_image = col_character()
## )
x28 <- read_rds("my-image-embed.rds")
dogs
## # A tibble: 12,954 x 5
## obs_id train_id class class_name path_to_image
## <chr> <chr> <dbl> <chr> <chr>
## 1 id_0000… train 2 n02088364 ~/Desktop/imagewoof-320/train/n02088…
## 2 id_0000… train 3 n02089973 ~/Desktop/imagewoof-320/train/n02089…
## 3 id_0000… train 5 n02096294 ~/Desktop/imagewoof-320/train/n02096…
## 4 id_0000… valid 9 n02115641 ~/Desktop/imagewoof-320/train/n02115…
## 5 id_0000… train 1 n02087394 ~/Desktop/imagewoof-320/train/n02087…
## 6 id_0000… valid 9 n02115641 ~/Desktop/imagewoof-320/train/n02115…
## 7 id_0000… valid 9 n02115641 ~/Desktop/imagewoof-320/train/n02115…
## 8 id_0000… train 6 n02099601 ~/Desktop/imagewoof-320/train/n02099…
## 9 id_0000… train 6 n02099601 ~/Desktop/imagewoof-320/train/n02099…
## 10 id_0000… train 0 n02086240 ~/Desktop/imagewoof-320/train/n02086…
## # … with 12,944 more rows
Ok, nice! Now we will determine our variables. There are 10 dog breeds we are looking at: Australian terrier, Border terrier, Samoyed, Beagle, Shih-Tzu, English foxhound, Rhodesian ridgeback, Dingo, Golden retriever, Old English sheepdog. These correspond to the number of classes.
Let’s check out some of the classes and images we are working with.
x28 <- x28[dogs$class %in% 0:9,]
dogs <- dogs[dogs$class %in% 0:9,]
dognames <- dogs$class_name[match(0:9, dogs$class)]
dognames <- factor(dognames, levels = dognames)
dim(x28)
## [1] 12954 2048
One of the classes is the Dingo! Let’s see what that class looks like:
image_path <- "desktop/imagewoof-320/train/n02115641/ILSVRC2012_val_00000604.jpeg"
image <- image_load(image_path, target_size = c(224,224))
image <- image_to_array(image)
image <- array_reshape(image, c(1, dim(image)))
par(mar = rep(0, 4L))
plot(0,0,xlim=c(0,1),ylim=c(0,1),axes= FALSE, type = "n", asp=1)
rasterImage(image[1,,,] / 255,0,0,1,1)
Let’s check out a few more because they’re so cute!
image_path <- "desktop/imagewoof-320/train/n02115641/ILSVRC2012_val_00015821.jpeg"
image <- image_load(image_path, target_size = c(224,224))
image <- image_to_array(image)
image <- array_reshape(image, c(1, dim(image)))
par(mar = rep(0, 4L))
plot(0,0,xlim=c(0,1),ylim=c(0,1),axes= FALSE, type = "n", asp=1)
rasterImage(image[1,,,] / 255,0,0,1,1)
image_path <- "desktop/imagewoof-320/train/n02115641/ILSVRC2012_val_00012401.jpeg"
image <- image_load(image_path, target_size = c(224,224))
image <- image_to_array(image)
image <- array_reshape(image, c(1, dim(image)))
par(mar = rep(0, 4L))
plot(0,0,xlim=c(0,1),ylim=c(0,1),axes= FALSE, type = "n", asp=1)
rasterImage(image[1,,,] / 255,0,0,1,1)
image_path <- "desktop/imagewoof-320/train/n02115641/ILSVRC2012_val_00038762.jpeg"
image <- image_load(image_path, target_size = c(224,224))
image <- image_to_array(image)
image <- array_reshape(image, c(1, dim(image)))
par(mar = rep(0, 4L))
plot(0,0,xlim=c(0,1),ylim=c(0,1),axes= FALSE, type = "n", asp=1)
rasterImage(image[1,,,] / 255,0,0,1,1)
Now let’s start with the configuring our training sets.
X <- t(apply(x28, 1, cbind))
y <- dogs$class
X_train <- X[dogs$train_id == "train",]
y_train <- to_categorical(dogs$class[dogs$train_id == "train"])
dim(X_train)
## [1] 7772 2048
dim(y_train)
## [1] 7772 10
Great! It’s now time to use the model on the entire data set! First let’s start by using neural networks.
model <- keras_model_sequential()
model %>%
layer_dense(units = 256, input_shape = ncol(X_train)) %>%
layer_activation(activation = "relu") %>%
layer_dropout(rate = 0.5) %>%
layer_dense(units = 256) %>%
layer_activation(activation = "relu") %>%
layer_dropout(rate = 0.5) %>%
layer_dense(units = ncol(y_train)) %>%
layer_activation(activation = "softmax")
model %>% compile(loss = 'categorical_crossentropy',
optimizer = optimizer_rmsprop(lr = 0.001 / 2),
metrics = c('accuracy'))
history <- model %>%
fit(X_train, y_train, epochs = 8)
plot(history)
Let’s see how well we did:
y_pred <- predict_classes(model, X)
tapply(y == y_pred, dogs$train_id, mean)
## train valid
## 0.9801853 0.9359321
Not bad! 92% correct is pretty good. Let’s try and increase the number of epochs to increase our validation rate.
model <- keras_model_sequential()
model %>%
layer_dense(units = 256, input_shape = ncol(X_train)) %>%
layer_activation(activation = "relu") %>%
layer_dropout(rate = 0.5) %>%
layer_dense(units = 256) %>%
layer_activation(activation = "relu") %>%
layer_dropout(rate = 0.5) %>%
layer_dense(units = ncol(y_train)) %>%
layer_activation(activation = "softmax")
model %>% compile(loss = 'categorical_crossentropy',
optimizer = optimizer_rmsprop(lr = 0.001 / 2),
metrics = c('accuracy'))
history <- model %>%
fit(X_train, y_train, epochs = 50)
plot(history)
Let’s see if we got any improvement:
y_pred <- predict_classes(model, X)
tapply(y == y_pred, dogs$train_id, mean)
## train valid
## 0.9976840 0.9370899
There is slight improvement on the validation set, but it is not remarkebly different. Let’s look at some of the images that were misclassified.
id <- sample(which(y_pred != y), 20)[1:12]
par(mfrow = c(3, 4))
for (i in id) {
par(mar = rep(0, 4L))
plot(0,0,xlim=c(0,1),ylim=c(0,1),axes= FALSE,type = "n", asp=1)
Z <- image_load(dogs$path_to_image[i], target_size=c(224, 224))
Z <- image_to_array(Z)
rasterImage(Z /255,0,0,1,1)
text(0.5, 0.1, label = dognames[y[i] + 1L], col = "red", cex=2)
}
Here we can see 12 of the dogs that were misclassifed. Since the breed names are not on there:
Photo #1:English Foxhound,
Photo #2: Old English Sheepdog,
Photo #3: Dingo,
Photo #4: Golden Retriever,
Photo #5: Australian Terrier,
Photo #6: Beagle,
Photo #7: Beagle,
Photo #8: Golden Retriever,
Photo #9: Beagle,
Photo #10: English Foxhound,
Photo #11: Australian Terrier, Photo #12: Border Terrier
Those are the breeds as predicted by the model.
Let’s now look at the dogs who fit their respective breeds the most!
y_probs <- predict(model, X)
# which are the maximum probs?
id <- apply(y_probs, 1, which.max)[1:12]
par(mfrow = c(3, 4))
for (i in id) {
par(mar = rep(0, 4L))
plot(0,0,xlim=c(0,1),ylim=c(0,1),axes= FALSE,type = "n", asp=1)
Z <- image_load(dogs$path_to_image[i], target_size=c(224, 224))
Z <- image_to_array(Z)
rasterImage(Z /255,0,0,1,1)
text(0.5, 0.1, label = dognames[y[i] + 1L], col = "red", cex=2)
}
We have a few repeat images but nevertheless these are the prime examples of an Australian Terrier, Dingo, another Dingo, Shih Tzu, English Foxhound, another Dingo, and Beagle.
These are the dogs that have the highest probabilty of being the correct breed. A big componant of the breeds is coloring. This is why Beagles and English Foxhounds get confused.
pca <- as_tibble(prcomp(X)$x[,1:2])
pca$y <- dognames[y + 1L]
ggplot(pca, aes(PC1, PC2)) +
geom_point(aes(color = y), alpha = 0.2, size = 7) +
labs(x = "", y = "", color = "class") +
theme_minimal()
*Overall, we have 93.6% correctness on determining the breed which is pretty good especially since you can see the heavy overlap in the different breeds.